| Compact Intervals

> {-# LANGUAGE ViewPatterns, BangPatterns #-}

> module Iv (
>   Iv, iv, lo, hi, dest, width, 
>   singl, mid, rad, ball, mem, intersect, union, 
>   subdivBox, 
>   -- * Relative boxes
>   RelBox, subdivRelBox
>   ) where

> import qualified Data.List as List

> data Iv a = Iv !a !a  deriving (Show,Eq)

> instance (Ord a, Num a) => Num (Iv a) where
>   Iv a1 a2 + Iv b1 b2 = Iv (a1+b1) (a2+b2)

>   Iv a1 a2 * Iv b1 b2 = 
>          if 0 <= a1 then
>                 if 0 <= b1 then Iv (a1*b1) (a2*b2)
>            else if 0 <= b2 then Iv (a2*b1) (a2*b2)
>                            else Iv (a2*b1) (a1*b2)
>     else if 0 <= a2 then
>                 if 0 <= b1 then Iv (a1*b2) (a2*b2)
>            else if 0 <= b2 then Iv (min (a1*b2) (a2*b1)) (max (a1*b1) (a2*b2))
>                            else Iv (a2*b1) (a1*b1)
>                     else
>                 if 0 <= b1 then Iv (a1*b2) (a2*b1)
>            else if 0 <= b2 then Iv (a1*b1) (a1*b2)
>                            else Iv (a2*b2) (a1*b1)
>   Iv a1 a2 - Iv b1 b2 = Iv (a1-b2) (a2-b1)
>   negate (Iv a1 a2)   = Iv (negate a2) (negate a1)
>   abs (Iv a b)        = let a' = abs a in 
>                         let b' = abs b in
>                           if a' <= b' then Iv a' b' else Iv b' a'
>   fromInteger i       = Iv.singl $ fromInteger i
>   signum (Iv a b) = if a > 0 then 1 else
>                     if b < 0 then -1 else 0

| Make an interval

> iv :: a -> a -> Iv a
> iv a b = Iv a b

| Lower bound

> lo :: Iv t -> t
> lo (Iv a b) = a

| Upper bound

> hi :: Iv t -> t
> hi (Iv a b) = b

| Destruct an interval

> dest :: Iv t -> (t, t)
> dest (Iv a b) = (a,b)

> instance (Ord a, Fractional a) => Fractional (Iv a) where
>   fromRational r   = Iv.singl $ fromRational r
>   recip (Iv a1 a2) | a1 <= 0 && 0 <= a2 = Iv (-1/0) (1/0)
>   recip (Iv a1 a2) | otherwise          = Iv (recip a2) (recip a1)

| Singleton interval

> singl :: a -> Iv a
> singl a = Iv a a

| Centered interval

> ball :: Num a => a -> a -> Iv a
> ball c r = Iv (c-r) (c+r)

| Membership

> mem :: Ord a => a -> Iv a -> Bool
> mem x (Iv a b) = a <= x && x <= b

| Diameter

> width :: Num a => Iv a -> a
> width (Iv a b) = b - a

| Radius

> rad :: Fractional a => Iv a -> a
> rad (Iv a b) = (b - a)/2

| Midpoint

> mid :: Fractional a => Iv a -> a
> mid (Iv a b) = (a+b)/2

| Subdivide a box along the given dimension

> subdivBox :: Fractional a => Int -> [Iv a] -> ([Iv a],[Iv a])
> subdivBox k x =
>   let (x1, Iv xk1 xk2:x2) = List.splitAt k x in --TODO use Aux.splitRev
>   let m = (xk1 + xk2) / 2 in
>   ((x1 ++ Iv xk1 m : x2),
>    (x1 ++ Iv m xk2 : x2))

| A relative box encodes information about its positioned relative to
an original box: the booleans indicate on which boundaries they
coincide.

> type RelBox a = [(Iv a, (Bool,Bool))]

> subdivRelBox :: Fractional a => Int -> RelBox a -> (RelBox a, RelBox a)
> subdivRelBox k x =
>   let (x1, (Iv xk1 xk2,(r1,r2)):x2) = List.splitAt k x in --TODO use Aux.splitRev
>   let m = (xk1 + xk2) / 2 in
>   ((x1 ++ (Iv xk1 m,(r1,False)) : x2),
>    (x1 ++ (Iv m xk2,(False,r2)) : x2))

> monoInc :: (a -> a) -> (Iv a -> Iv a)
> monoInc f (Iv a b) = Iv (f a) (f b)

> monoDec :: (a -> a) -> (Iv a -> Iv a)
> monoDec f (Iv a b) = Iv (f b) (f a)

| Intersection

> intersect :: Ord t => Iv t -> Iv t -> Iv t
> intersect (Iv a1 a2) (Iv b1 b2) = Iv (max a1 b1) (min a2 b2)

| Union

> union :: Ord t => Iv t -> Iv t -> Iv t
> union     (Iv a1 a2) (Iv b1 b2) = Iv (min a1 b1) (max a2 b2)

> instance (Ord a, Floating a) => Floating (Iv a) where
>   pi      = Iv.singl pi
>   exp     = Iv.monoInc exp
>   sqrt    = Iv.monoInc sqrt
>   log     = error "Iv/... not implemented"
>   (**)    = error "Iv/... not implemented"
>   logBase = error "Iv/... not implemented"
>   sin     = error "Iv/... not implemented"
>   tan     = error "Iv/... not implemented"
>   cos     = error "Iv/... not implemented"
>   asin    = error "Iv/... not implemented"
>   atan    = monoInc atan
>   acos    = error "Iv/... not implemented"
>   sinh    = error "Iv/... not implemented"
>   tanh    = error "Iv/... not implemented"
>   cosh    = error "Iv/... not implemented"
>   asinh   = error "Iv/... not implemented"
>   atanh   = error "Iv/... not implemented"
>   acosh   = error "Iv/... not implemented"